home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / forth / pfe-0.000 / pfe-0 / pfe-0.9.13 / test / tester.fr < prev    next >
Encoding:
Text File  |  1993-10-11  |  1.5 KB  |  50 lines
  1. \ (C) 1993 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
  2. \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
  3. \ VERSION 1.0
  4. HEX
  5.  
  6. \ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
  7. \ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.
  8. VARIABLE VERBOSE
  9.    FALSE VERBOSE !
  10.  
  11. : EMPTY-STACK    \ ( ... -- ) EMPTY STACK.
  12.    DEPTH ?DUP IF 0 DO DROP LOOP THEN ;
  13.  
  14. : ERROR        \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
  15.         \ THE LINE THAT HAD THE ERROR.
  16.    TYPE SOURCE TYPE CR            \ DISPLAY LINE CORRESPONDING TO ERROR
  17.    EMPTY-STACK                \ THROW AWAY EVERY THING ELSE
  18. ;
  19.  
  20. VARIABLE ACTUAL-DEPTH            \ STACK RECORD
  21. CREATE ACTUAL-RESULTS 20 CELLS ALLOT
  22.  
  23. : {        \ ( -- ) SYNTACTIC SUGAR.
  24.    ;
  25.  
  26. : ->        \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
  27.    DEPTH DUP ACTUAL-DEPTH !        \ RECORD DEPTH
  28.    ?DUP IF                \ IF THERE IS SOMETHING ON STACK
  29.       0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
  30.    THEN ;
  31.  
  32. : }        \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
  33.         \ (ACTUAL) CONTENTS.
  34.    DEPTH ACTUAL-DEPTH @ = IF        \ IF DEPTHS MATCH
  35.       DEPTH ?DUP IF            \ IF THERE IS SOMETHING ON THE STACK
  36.          0 DO                \ FOR EACH STACK ITEM
  37.         ACTUAL-RESULTS I CELLS + @    \ COMPARE ACTUAL WITH EXPECTED
  38.         <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN
  39.      LOOP
  40.       THEN
  41.    ELSE                    \ DEPTH MISMATCH
  42.       S" WRONG NUMBER OF RESULTS: " ERROR
  43.    THEN ;
  44.  
  45. : TESTING    \ ( -- ) TALKING COMMENT.
  46.    SOURCE VERBOSE @
  47.    IF DUP >R TYPE CR R> >IN !
  48.    ELSE >IN ! DROP
  49.    THEN ;
  50.